home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 355 / source / oops_js / oops.mod < prev    next >
Text File  |  1990-02-02  |  7KB  |  223 lines
  1. MODULE oops; (* Ken Badertscher (KBAD) 2/22/87 *)
  2.  
  3. (* Enhanced version of errout, takes compiler-generated ERR.DAT and ERR.LST,
  4.     flags errors and inserts error messages into source file *)
  5.  
  6. (****************************************************) 
  7. (*   Written using the Jefferson Software Modula-2  *)
  8. (*                 Development System               *)
  9. (* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *)
  10. (*    Jefferson Software           (602)243-3106    *)
  11. (* 12416 N 28th Dr #18-236, Phoenix, AZ  85029-2434 *)
  12. (* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *) 
  13. (*  For information on and examples of  JS Modula,  *)
  14. (*    call the PHASE BBS (602)849-1287, 24 hours,   *)
  15. (*        up to 2400 baud, and visit SIG 8.         *)
  16. (****************************************************)
  17.  
  18. FROM Terminal IMPORT 
  19.   Read, Write, WriteLn, WriteString;
  20. FROM FileSystem IMPORT      
  21.   (*TYPE*)
  22.     File, Response, 
  23.   (*PROCEDURE*)
  24.     Lookup, ReadChar, WriteChar, Close, Delete, Rename;
  25.  
  26. (* modules needed due to "too many strings" limit of 127 string constants *)
  27. FROM oopsmsg1 IMPORT AssignErr1,ErrMsgs;
  28. FROM oopsmsg2 IMPORT AssignErr2;
  29. FROM oopsmsg3 IMPORT AssignErr3;
  30.  
  31.  
  32. CONST NL          = 27;     (* max filename length *)
  33.       Old         = FALSE;  (* for Lookup calls *)
  34.       New         = TRUE;   (* for Lookup calls *)
  35.       ErrPerLine  = 4;      (* errors detected per line *)
  36.       ChPerErr    = 78;     (* max error message length *)
  37.       TotErrMsgs  = 172;    (* total number of defined error msgs *)
  38.  
  39. TYPE  ErrLns = ARRAY [0..ErrPerLine] OF
  40.                   ARRAY [0..ChPerErr] OF CHAR;
  41.  
  42. VAR ch: CHAR;
  43.     InFileName,OutFileName: ARRAY [0..NL] OF CHAR;
  44.     i,j,errpos,pos,errInLine: INTEGER;
  45.     error : CARDINAL;
  46.     errDAT, errf, source : File;
  47.     moreErrors : BOOLEAN;
  48.     errorLines : ErrLns;
  49.     errorMsgs : ErrMsgs;
  50.  
  51.  
  52. PROCEDURE GetError (f : File; 
  53.                     VAR erroff : INTEGER;
  54.                     VAR errnum : CARDINAL) : BOOLEAN;
  55.  
  56. (* reads next error from err.dat, returns error number and "more" flag *)
  57.  
  58.   VAR more : BOOLEAN;
  59.       err : RECORD
  60.         CASE :INTEGER OF
  61.           0: a,b,c,d : CHAR
  62.         | 1: x,offset  : INTEGER
  63.         END;
  64.         CASE :INTEGER OF
  65.           0: l,h     : CHAR
  66.         | 1: error   : CARDINAL
  67.         END
  68.       END;
  69.   BEGIN
  70.     ReadChar(f,err.d);
  71.     more := (err.d = 301C); (* start char of error entry *)
  72.     IF  more THEN
  73.       ReadChar(f,err.d);  (* offset of error in source file *)
  74.       ReadChar(f,err.c);
  75.       ReadChar(f,err.b);  (* 2 dummy bytes *)
  76.       ReadChar(f,err.a);
  77.       ReadChar(f,err.h);  (* error number *)
  78.       ReadChar(f,err.l);
  79.       erroff := err.offset;
  80.       errnum := err.error;
  81. (* check if error is defined, or needs offset calculated
  82.    undefined errors: 0-9,29,43-49,87,99,138,143,148,149,151-199,217,221 *)
  83.       IF (errnum < 10) OR (errnum = 29) OR ((errnum >42) AND (errnum < 50))
  84.           OR (errnum = 87) OR (errnum = 99) OR (errnum = 138)
  85.           OR (errnum = 143) OR (errnum = 148) OR (errnum = 149)
  86.           OR ((errnum > 150) AND (errnum < 200)) OR (errnum = 217)
  87.           OR (errnum = 221) OR (errnum > 226)
  88.         THEN errnum := 0;
  89.  (* Offsets for error numbers > 199 *) 
  90.       ELSIF ((errnum > 199) AND (errnum < 217))
  91.         THEN errnum := errnum - 49;
  92.       ELSIF ((errnum > 221) AND (errnum < 227))
  93.         THEN errnum := errnum - 54;
  94.       END (* IF errnum *) ;
  95.     END (* IF more *) ;
  96.     RETURN more;
  97. END GetError;
  98.  
  99. BEGIN (* m2err *)
  100.  
  101. (* read error messages into errorMsgs *)
  102.   AssignErr1(errorMsgs);
  103.   AssignErr2(errorMsgs);
  104.   AssignErr3(errorMsgs);
  105.  
  106. (* open error file, get source filename *)
  107.   Lookup(errDAT, 'err.dat', Old);
  108.   IF (errDAT.res = done) THEN
  109.     ReadChar(errDAT,ch);
  110.     IF (ch = 300C) THEN
  111.       i := 0;
  112.       WHILE (ch # 0C) DO
  113.         ReadChar(errDAT,ch);
  114.         InFileName[i] := ch;
  115.         INC(i);
  116.       END;
  117.     ELSE
  118.       WriteString ('ERR.DAT had a bad header.'); WriteLn;
  119.       Close(errDAT);
  120.       HALT;
  121.     END;
  122.  
  123.     Lookup(source, InFileName, Old);
  124.     IF (source.res = done) THEN
  125.       WriteLn; WriteString('Flagging errors in '); WriteString(InFileName); 
  126.  
  127. (* Set output filename, open new error file *)
  128.       i := 0;
  129.       REPEAT
  130.         OutFileName[i] := InFileName[i];
  131.         INC(i)
  132.       UNTIL (InFileName[i] = '.') OR (InFileName[i] = 0C);
  133.       OutFileName[i] := '.';
  134.       OutFileName[i+1] := 'E';
  135.       OutFileName[i+2] := 'R';
  136.       OutFileName[i+3] := 'R';
  137.       Lookup(errf,OutFileName,New);
  138.       IF (errf.res = callerror) THEN (* old file opened *)
  139.         Close(errf);
  140.         Delete(errf);
  141.         Lookup(errf,OutFileName,New)
  142.       END;
  143.  
  144. (* write error file *)
  145.       IF (errf.res = done) THEN
  146.         pos := 0;
  147.         moreErrors := GetError(errDAT,errpos,error);
  148.         WHILE moreErrors DO
  149.   (* copy until error reached *)
  150.           errInLine := 0;
  151.           REPEAT
  152.             ReadChar(source,ch);
  153.             WriteChar(errf,ch);
  154.             INC(pos);
  155.   (* flag error and store message until EOL reached *)
  156.             IF (moreErrors) AND (pos >= errpos) THEN
  157.               IF (errInLine <= ErrPerLine) THEN
  158.                 WriteChar(errf,'('); WriteChar(errf,'*');
  159.                 WriteChar(errf,'<'); WriteChar(errf,'@');
  160.                 WriteChar(errf,'*'); WriteChar(errf,')');
  161.                 i := 0;
  162.                 REPEAT
  163.                   errorLines[errInLine][i] := errorMsgs[error][i];
  164.                   INC(i);
  165.                 UNTIL (errorMsgs[error][i] = 0C);
  166.                 INC(errInLine);
  167.               END;
  168.               WriteLn; WriteString('oops!');
  169.               moreErrors := GetError(errDAT,errpos,error);
  170.             END;
  171.           UNTIL (ch = 12C);
  172.   (* write error message(s) *)
  173.           FOR i := 0 TO (errInLine-1) DO
  174.             j := 0;
  175.             REPEAT
  176.               WriteChar(errf,errorLines[i][j]);
  177.               errorLines[i][j] := 0C;
  178.               INC(j);
  179.             UNTIL (errorLines[i][j] = 0C);
  180.             WriteChar(errf,15C);WriteChar(errf,12C);
  181.           END (* FOR i *) ;
  182.         END (* WHILE moreErrors *);
  183.   (* no more errors - copy remainder of source *)
  184.         ReadChar(source,ch);
  185.         WHILE (NOT source.eof) DO
  186.           WriteChar(errf,ch);
  187.           ReadChar(source,ch);
  188.         END;
  189.         WriteChar(errf,15C);
  190.         WriteChar(errf,12C);
  191.  
  192. (* Cleanup *)
  193.         Close(errDAT);
  194.         Delete(errDAT);
  195.         Close(source);
  196.         Delete(source);
  197.         Rename(errf,InFileName);
  198.         Close(errf);
  199.         Lookup(errDAT, 'err.lst', Old);
  200.         IF (errDAT.res = done) THEN
  201.           Close(errDAT);
  202.           Delete(errDAT);
  203.         END;
  204.         WriteLn; WriteLn; 
  205.         WriteString(InFileName); WriteString(' rewritten.'); WriteLn;
  206.        ELSE
  207.         Close(source);
  208.         Close(errDAT);
  209.         WriteLn; WriteLn;
  210.         WriteString('Error opening '); WriteString(OutFileName);
  211.       END (* IF (errf.res = done) *);
  212.     ELSE
  213.       WriteLn; WriteString(InFileName); WriteString(" not found."); WriteLn;
  214.       Close(errDAT);
  215.     END (* IF (source.res = done) *);
  216.   ELSE
  217.     WriteLn; WriteString('Lookup errDAT returned an error.'); WriteLn;
  218.   END (* IF (errDAT.res = done) *);
  219.   WriteLn; WriteString("That's all, folks!"); WriteLn;
  220. END oops.
  221.  
  222.  
  223.